home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / chap09 / howto04 / cciccfrm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-06-11  |  69.1 KB  |  2,067 lines
  1. unit Cciccfrm;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, Menus, FileCtrl,
  8.   {Winsock,} CCWSock, CCICCInf, CCICCPrf, IniFiles, Gauges;
  9.  
  10. type
  11.   { This record holds the information for a number of internet connections }
  12.   PConnectionsRecord = ^TConnectionsRecord;
  13.   TConnectionsRecord = record
  14.     CProfile   : string; { Connection profile; used in lists }
  15.     CIPAddress : string; { Dotted character IP Address       }
  16.     CUserName  : string; { Login name to site; can be anonym }
  17.     CPassword  : string; { Password; won't be shown          }
  18.     CStartDir  : string; { Starting directory; used for FTP  }
  19.   end;
  20.   { Array of TCR }
  21.   CRFile = file of TConnectionsRecord; { File type for TCRec }
  22.   TCCINetCCForm = class(TForm)
  23.     Panel1: TPanel;
  24.     Panel2: TPanel;
  25.     Panel3: TPanel;
  26.     Panel4: TPanel;
  27.     Panel5: TPanel;
  28.     Panel6: TPanel;
  29.     ListBox1: TListBox;
  30.     Panel7: TPanel;
  31.     SpeedButton1: TSpeedButton;
  32.     SpeedButton2: TSpeedButton;
  33.     ListBox2: TListBox;
  34.     ComboBox1: TComboBox;
  35.     Button1: TButton;
  36.     Memo1: TMemo;
  37.     SpeedButton4: TSpeedButton;
  38.     SpeedButton5: TSpeedButton;
  39.     SpeedButton3: TSpeedButton;
  40.     Panel8: TPanel;
  41.     Label1: TLabel;
  42.     Label2: TLabel;
  43.     ComboBox2: TComboBox;
  44.     Label3: TLabel;
  45.     ComboBox3: TComboBox;
  46.     Label4: TLabel;
  47.     Label5: TLabel;
  48.     OpenDialog1: TOpenDialog;
  49.     SaveDialog1: TSaveDialog;
  50.     PrintDialog1: TPrintDialog;
  51.     PrinterSetupDialog1: TPrinterSetupDialog;
  52.     FindDialog1: TFindDialog;
  53.     ReplaceDialog1: TReplaceDialog;
  54.     Gauge1: TGauge;
  55.     MainMenu1: TMainMenu;
  56.     Network1: TMenuItem;
  57.     ViewWinsockInfo1: TMenuItem;
  58.     Description1: TMenuItem;
  59.     SystemStatus1: TMenuItem;
  60.     VendorSpecific1: TMenuItem;
  61.     N1: TMenuItem;
  62.     ProgressInfo1: TMenuItem;
  63.     ViewInEditWindow1: TMenuItem;
  64.     ViewInStatusLine1: TMenuItem;
  65.     SaveToFile1: TMenuItem;
  66.     N2: TMenuItem;
  67.     Exit1: TMenuItem;
  68.     Services1: TMenuItem;
  69.     IPAddress1: TMenuItem;
  70.     EMail1: TMenuItem;
  71.     FTP1: TMenuItem;
  72.     UsenetNws1: TMenuItem;
  73.     Files1: TMenuItem;
  74.     Load1: TMenuItem;
  75.     Save1: TMenuItem;
  76.     Encoding1: TMenuItem;
  77.     UUDecode1: TMenuItem;
  78.     MIMEDecode1: TMenuItem;
  79.     UUEncode1: TMenuItem;
  80.     MIMEEncode1: TMenuItem;
  81.     Edit1: TMenuItem;
  82.     Cut1: TMenuItem;
  83.     Copy1: TMenuItem;
  84.     CopytoFile1: TMenuItem;
  85.     Paste1: TMenuItem;
  86.     PastefromFile1: TMenuItem;
  87.     EMail2: TMenuItem;
  88.     CheckMail1: TMenuItem;
  89.     CreateNewMessage1: TMenuItem;
  90.     ReplyToCurrentMessage1: TMenuItem;
  91.     SendCurrentMessage1: TMenuItem;
  92.     SendQueue1: TMenuItem;
  93.     MailServers1: TMenuItem;
  94.     Mailboxes1: TMenuItem;
  95.     Correspondents1: TMenuItem;
  96.     TrashMarkedMessages1: TMenuItem;
  97.     EmptyTrash1: TMenuItem;
  98.     ExitEMailRequired1: TMenuItem;
  99.     FTP2: TMenuItem;
  100.     ConnectToSite1: TMenuItem;
  101.     Disconnect1: TMenuItem;
  102.     UploadMarked1: TMenuItem;
  103.     ASCII1: TMenuItem;
  104.     Binary1: TMenuItem;
  105.     DownloadMarked1: TMenuItem;
  106.     ASCII2: TMenuItem;
  107.     ToFile1: TMenuItem;
  108.     ToDisplay1: TMenuItem;
  109.     Binary2: TMenuItem;
  110.     Directory1: TMenuItem;
  111.     ViewRemoteasText1: TMenuItem;
  112.     ViewasText1: TMenuItem;
  113.     Change1: TMenuItem;
  114.     Create1: TMenuItem;
  115.     Delete3: TMenuItem;
  116.     ChangeLocal1: TMenuItem;
  117.     DeleteRemoteFiles1: TMenuItem;
  118.     FTPSites1: TMenuItem;
  119.     News1: TMenuItem;
  120.     ConnectandUpdate1: TMenuItem;
  121.     Disconnect2: TMenuItem;
  122.     Headers1: TMenuItem;
  123.     RetrieveMarked1: TMenuItem;
  124.     RetrieveAll1: TMenuItem;
  125.     CheckNewNews1: TMenuItem;
  126.     GetMarked1: TMenuItem;
  127.     Article1: TMenuItem;
  128.     NewArticle1: TMenuItem;
  129.     FollowupArticle1: TMenuItem;
  130.     PutinQueue1: TMenuItem;
  131.     Post1: TMenuItem;
  132.     CurrentArticle1: TMenuItem;
  133.     EntireQueue1: TMenuItem;
  134.     NewsServers1: TMenuItem;
  135.     SubscribedNewsgroups1: TMenuItem;
  136.     Trash1: TMenuItem;
  137.     AllReadArticles1: TMenuItem;
  138.     AllMarkedArticles1: TMenuItem;
  139.     AllAvailableArticles1: TMenuItem;
  140.     DownloadActiveNewsgroups1: TMenuItem;
  141.     Preferences1: TMenuItem;
  142.     EMail3: TMenuItem;
  143.     FTP3: TMenuItem;
  144.     News2: TMenuItem;
  145.     Paths1: TMenuItem;
  146.     procedure Exit1Click(Sender: TObject);
  147.     procedure FormCreate(Sender: TObject);
  148.     procedure FormDestroy(Sender: TObject);
  149.     procedure Description1Click(Sender: TObject);
  150.     procedure SystemStatus1Click(Sender: TObject);
  151.     procedure VendorSpecific1Click(Sender: TObject);
  152.     procedure ViewInEditWindow1Click(Sender: TObject);
  153.     procedure ViewInStatusLine1Click(Sender: TObject);
  154.     procedure SaveToFile1Click(Sender: TObject);
  155.     procedure IPAddress1Click(Sender: TObject);
  156.     procedure FTP1Click(Sender: TObject);
  157.     procedure FormResize(Sender: TObject);
  158.     procedure FTPSites1Click(Sender: TObject);
  159.     procedure FTP3Click(Sender: TObject);
  160.     procedure ConnectToSite1Click(Sender: TObject);
  161.     procedure Button1Click(Sender: TObject);
  162.     procedure Disconnect1Click(Sender: TObject);
  163.     procedure Change1Click(Sender: TObject);
  164.     procedure ChangeLocal1Click(Sender: TObject);
  165.     procedure ListBox1DblClick(Sender: TObject);
  166.     procedure ListBox2DblClick(Sender: TObject);
  167.   private
  168.     { Private declarations }
  169.   public
  170.     { Public declarations }
  171.     procedure EnableFTPMenus;
  172.     procedure DisableFTPMenus;
  173.     procedure UpdateGauge( BytesFinished , TotalToHandle : longint );
  174.     function DoFTPConnection( PCRPointer : PConnectionsRecord ) : boolean;
  175.     procedure DoFTPDisconnect;
  176.     procedure ReadIniData;
  177.     procedure WriteIniData;
  178.     procedure LoadFTPSiteFile;
  179.     procedure SaveFTPSiteFile;
  180.     procedure SetupFTPSiteLists;
  181.     procedure AddNullTermTextToMemo( TheTextToAdd   : string;
  182.                                      TheMemoToAddTo : TMemo   );
  183.     function AddNullTermTextToLabel( TheTextToAdd   : string ) : string;
  184.     procedure SetHGCursors;
  185.     procedure SetNormalCursors;
  186.     procedure AddProgressText( WhatText : string );
  187.     procedure ShowProgressText( WhatText : string );
  188.     procedure ShowProgressErrorText( WhatText : string );
  189.     procedure SocketsErrorOccurred( Sender     : TObject;
  190.                                      ErrorCode  : Integer;
  191.                                      TheMessage : string   );
  192.   end;
  193.   { Component to hold FTP handling capabilities }
  194.   TFTPComponent = class( TWinControl )
  195.   public
  196.     FTPCommandInProgress ,
  197.     Connection_Established : Boolean;
  198.     Socket1 : TCCSocket;
  199.     Socket2 : TCCSocket;
  200.     constructor Create( AOwner : TComponent ); override;
  201.     destructor Destroy; override;
  202.     function StripBrackets( TheString : string ) : string;
  203.     function GetShortPathname( TheString : string ) : string;
  204.     function GetWin16FileName( InputName : string ) : string;
  205.     function GetRemoteWorkingDirectory( var RemoteDir : string ) : Boolean;
  206.     function SetRemoteDirectory( TheDir : string ) : Boolean;
  207.     function EstablishConnection( PCRPointer : PConnectionsRecord ) : Boolean;
  208.     function LoginUser( PCRPointer : PConnectionsRecord ) : Boolean;
  209.     function SendPassword( PCRPointer : PConnectionsRecord ) : Boolean;
  210.     function SetRemoteStartupDirectory( PCRPointer : PConnectionsRecord )
  211.               : Boolean;
  212.     function GetRemoteDirectoryListing( TheListBox : TListBox ) : Boolean;
  213.     function GetLocalDirectoryAndListing( var TheString : string;
  214.                                               TheListBox : TListBox )
  215.               : Boolean;
  216.     function GetUNIXTextString( var StringIn : string ) : string;
  217.     function GetListeningPort : Integer;
  218.     procedure GetFileNameFromUNIXFileName( var TheName : string );
  219.     function Disconnect : Boolean;
  220.     function DoCStyleFormat(       TheText      : string;
  221.                              const TheArguments : array of const ) : string;
  222.     procedure UpdateGauge( BytesFinished , TotalToHandle : longint );
  223.     function GetQuotedString( TheString : string ) : string;
  224.     procedure AddProgressText( WhatText : string );
  225.     procedure ShowProgressText( WhatText : string );
  226.     procedure ShowProgressErrorText( WhatText : string );
  227.     function GetFTPServerResponse( var ResponseString : string ) : Integer;
  228.     procedure FTPSocketsErrorOccurred( Sender     : TObject;
  229.                                      ErrorCode  : Integer;
  230.                                      TheMessage : string   );
  231.     function PerformFTPCommand(
  232.                     TheCommand   : string;
  233.               const TheArguments : array of const ) : Integer;
  234.   end;
  235. const
  236.   POV_MEMO                 = 1; { Progress to the Memo           }
  237.   POV_STAT                 = 2; { Progress to the status caption }
  238.   FTP_STATUS_PRELIMINARY   = 1; { Wait; command being processed  }
  239.   FTP_STATUS_COMPLETED     = 2; { Done; command fully succeded   }
  240.   FTP_STATUS_CONTINUING    = 3; { OK; send more data to finish   }
  241.   FTP_STATUS_RETRY_COMMAND = 4; { Temporary Error; try cmd again }
  242.   FTP_STATUS_FATAL_ERROR   = 5; { Fatal Error; don't retry cmd   }
  243.  
  244. var
  245.   CCINetCCForm         : TCCINetCCForm;
  246.   GlobalErrorCode      : Integer;        { Used to pass around error info  }
  247.   GlobalAbortedFlag    : Boolean;        { Used to signal timeout error    }
  248.   ProgressList         : TStringList;    { Used to hold progress text info }
  249.   ProgressFileName     : string;         { Used to hold progress file name }
  250.   ProgressOutputVector : Integer;        { Used to direct progress output  }
  251.   TheFTPSiteList       : TList;          { Used to store the FTP site recs }
  252.   TheWorkingFTPSL      : TList;          { Used to store working copy of l }
  253.   TheFTPSiteFile       : CRFile;         { Used to load the FTP site file  }
  254.   TheICCIniFile        : TIniFile;       { Used to retrieve the INI File   }
  255.   MailPath             : string;         { Used for path to Mail Files     }
  256.   NewsPath             : string;         { Used for path to News Files     }
  257.   WWWPath              : string;         { Used for path to WWW Files      }
  258.   FTPPath              : string;         { Used for path to FTP Files      }
  259.   CurrentPassWordString : string;        { Used to hold login id for anons }
  260.   PassWordControlVector : Integer;       { Used to hold display of pw vect }
  261.   CurrentRealPWString   : string;        { Used to hold a real password    }
  262.   TheFTPComponent       : TFTPComponent; { FTP Object                      }
  263.   TheLine ,
  264.   HolderLine ,
  265.   GlobalTextBuffer      : string;
  266.   TheAnonRedialVector ,
  267.   DefaultDownloadVector : Integer;
  268.   LeftoverText          : string;
  269.   LeftoversOnTable      : Boolean;
  270.   FileNameToXFer        : string;
  271.  
  272. implementation
  273.  
  274. {$R *.DFM}
  275.  
  276. { This is the FTP component constructor; it creates 2 sockets }
  277. constructor TFTPComponent.Create( AOwner : TComponent );
  278. begin
  279.   { do inherited create }
  280.   inherited Create( AOwner );
  281.   { Create sockets, put in their parents, and error procs }
  282.   Socket1 := TCCSocket.Create( Self );
  283.   Socket1.Parent := Self;
  284.   Socket1.OnErrorOccurred := FTPSocketsErrorOccurred;
  285.   Socket2 := TCCSocket.Create( Self );
  286.   Socket2.Parent := Self;
  287.   Socket2.OnErrorOccurred := FTPSocketsErrorOccurred;
  288.   { Set up booleans }
  289.   Connection_Established := false;
  290.   FTPCommandInProgress := false;
  291. end;
  292.  
  293. { This is the FTP component destructor; it frees 2 sockets }
  294. destructor TFTPComponent.Destroy;
  295. begin
  296.   { Free the sockets }
  297.   Socket1.Free;
  298.   Socket2.Free;
  299.   { and call inherited }
  300.   inherited Destroy;
  301. end;
  302.  
  303. function TFTPComponent.GetShortPathname( TheString : string ) : string;
  304. var HoldingString : string;
  305. begin
  306.   HoldingString := Copy( TheString , 1 , 3 );
  307.   HoldingString := HoldingString + '..\' + ExtractFileName( TheString );
  308.   Result := HoldingString;
  309. end;
  310.  
  311. function TFTPComponent.StripBrackets( TheString : string ) : string;
  312. var HoldingString : string;
  313.     HoldingPosition : Integer;
  314. begin
  315.   HoldingPosition := Pos( '[' , TheString );
  316.   if HoldingPosition = 0 then
  317.   begin
  318.     Result := TheString;
  319.     exit;
  320.   end
  321.   else
  322.   begin
  323.     HoldingString := Copy( TheString , HoldingPosition + 1 , 255 );
  324.     HoldingPosition := Pos( ']' , HoldingString );
  325.     if HoldingPosition = 0 then
  326.     begin
  327.       Result := HoldingString;
  328.       exit;
  329.     end
  330.     else
  331.     begin
  332.       HoldingString := Copy( HoldingString , 1 , HoldingPosition - 1 );
  333.       Result := HoldingString;
  334.       exit;
  335.     end;
  336.   end;
  337. end;
  338.  
  339. { This function takes a UNIX filespec and turns it into a Win16 filename }
  340. function TFTPComponent.GetWin16FileName( InputName : string ) : string;
  341. var WorkingString ,
  342.     HoldingString   : string; { Holding string }
  343. begin
  344.   WorkingString := ExtractFileExt( InputName );
  345.   if WorkingString = '' then
  346.   begin
  347.     if Length( InputName ) > 8 then
  348.      WorkingString := Copy( InputName , 1 , 8 ) else
  349.       WorkingString := InputName;
  350.   end
  351.   else
  352.   begin
  353.     if Length( WorkingString ) > 4 then
  354.      WorkingString := Copy( WorkingString , 1 , 4 );
  355.     HoldingString :=
  356.      Copy( InputName , 1 , Pos( WorkingString , InputName ) - 1 );
  357.     if Length( HoldingString ) > 8 then
  358.      HoldingString := Copy( HoldingString , 1 , 8 );
  359.     if HoldingString = '' then
  360.     begin
  361.       { Dot file }
  362.       HoldingString := Copy( InputName , 2 , 255 ) + '.TXT';
  363.       WorkingString := HoldingString;
  364.     end
  365.     else WorkingString := HoldingString + WorkingString;
  366.   end;
  367.   Result := WorkingString;
  368. end;
  369.  
  370.  
  371. procedure TFTPComponent.UpdateGauge( BytesFinished , TotalToHandle : longint );
  372. begin
  373.   CCInetCCForm.UpdateGauge( BytesFinished , TotalToHandle );
  374. end;
  375.  
  376. { This sends FTP progress text to the Inet form }
  377. procedure TFTPComponent.AddProgressText( WhatText : string );
  378. begin
  379.   CCInetCCForm.AddProgressText( WhatText );
  380. end;
  381.  
  382. { This sends FTP progress text to the Inet form }
  383. procedure TFTPComponent.ShowProgressText( WhatText : string );
  384. begin
  385.   CCInetCCForm.ShowProgressText( WhatText );
  386. end;
  387.  
  388. { This sends FTP progress text to the Inet form }
  389. procedure TFTPComponent.ShowProgressErrorText( WhatText : string );
  390. begin
  391.   CCInetCCForm.ShowProgressErrorText( WhatText );
  392. end;
  393.  
  394. { This is a core function! It performs an FTP command and if no timeout }
  395. { return a preliminary ok.                                              }
  396. function TFTPComponent.PerformFTPCommand(
  397.                  TheCommand        : string;
  398.            const TheArguments      : array of const ) : Integer;
  399. var TheBuffer : string; { Text buffer }
  400. begin
  401.   { If command in progress send back -1 error }
  402.   if FTPCommandInProgress then
  403.   begin
  404.     Result := -1;
  405.     exit;
  406.   end;
  407.   { Set status variable }
  408.   FTPCommandInProgress := True;
  409.   { Set global error code }
  410.   GlobalErrorCode := 0;
  411.   { Format output string }
  412.   TheBuffer := Format( TheCommand , TheArguments );
  413.   { Preset failure code }
  414.   Result := FTP_STATUS_FATAL_ERROR;
  415.   { If invalid socket or no connection abort }
  416.   if ( Socket1.TheSocket = INVALID_SOCKET ) or not Connection_Established then
  417.    exit;
  418.   { Send the buffer plus EOL chars }
  419.   Socket1.StringData := TheBuffer + #13#10;
  420.   { if abort due to timeout or other error exit }
  421.   if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  422.   { Otherwise return preliminary code }
  423.   Result := FTP_STATUS_PRELIMINARY;
  424. end;
  425.  
  426. { This function gets up to 255 chars of data plus a return code from FTP serv }
  427. function TFTPComponent.GetFTPServerResponse(
  428.           var ResponseString : string ) : Integer;
  429. var
  430.   { Buffer string for response line }
  431.   TheBuffer     : string;
  432.   { Pointer to the response string }
  433.   BufferPointer : array[0..255] of char absolute TheBuffer;
  434.   { Character to check for response code }
  435.   ResponseChar   : char;
  436.   { Pointers into returned string }
  437.   TheIndex ,
  438.   TheLength     : Integer;
  439.   { Control variable }
  440.   LeftoversInPan ,
  441.   Finished      : Boolean;
  442. begin
  443.   { Preset fatal error }
  444.   Result := FTP_STATUS_FATAL_ERROR;
  445.   { Start loop control }
  446.   LeftoversInPan := false;
  447.   Finished := false;
  448.   repeat
  449.     { Do a peek }
  450.     TheBuffer := Socket1.PeekData;
  451.     { If timeout or other error exit }
  452.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  453.     { Find end of line character }
  454.     TheIndex := Pos( #10 , TheBuffer );
  455.     if TheIndex = 0 then
  456.     begin
  457.       TheIndex := Pos( #13 , TheBuffer );
  458.       if TheIndex = 0 then
  459.       begin
  460.         TheIndex := Pos( #0 , TheBuffer );
  461.         if TheIndex = 0 then
  462.         begin
  463.           TheIndex := Length( TheBuffer );
  464.           LeftoversInPan := True;
  465.           LeftoverText := LeftoverText + TheBuffer;
  466.           LeftoversOnTable := false;
  467.         end;
  468.       end;
  469.     end;
  470.     { If an end of line then process the line }
  471.     if TheIndex > 0 then
  472.     begin
  473.       { Get length of string }
  474.       TheLength := TheIndex;
  475.       { Receive actual data }
  476.       Socket1.CCSockReceive( Socket1.TheSocket   ,
  477.                              @BufferPointer[ 1 ] ,
  478.                              TheLength              );
  479.       { Abort if timeout or error }
  480.       if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  481.       { Put in the length byte }
  482.       BufferPointer[ 0 ] := Chr( TheLength );
  483.       if LeftOversOnTable then
  484.       begin
  485.         LeftOversOnTable := false;
  486.         ResponseString := LeftoverText + TheBuffer;
  487.         TheBuffer := ResponseString;
  488.         LeftoverText := '';
  489.       end;
  490.       if LeftoversInPan then
  491.       begin
  492.         LeftoversInPan := false;
  493.         LeftoversOnTable := true;
  494.       end;
  495.       { If not a continuation line }
  496.       if TheBuffer[ 4 ] <> '-' then
  497.       begin
  498.         { Get first number character }
  499.         ResponseChar := TheBuffer[ 1 ];
  500.         { Get the value of the number from 1 to 5 }
  501.         if (( ResponseChar >= '1' ) and ( ResponseChar <= '5' )) then
  502.         begin
  503.           Finished := true;
  504.           Result := Ord( ResponseChar ) - 48;
  505.         end;
  506.       end
  507.       else
  508.       begin
  509.         { otherwise return preliminary result }
  510.         Finished := true;
  511.         Result := FTP_STATUS_PRELIMINARY;
  512.       end;
  513.     end
  514.     else
  515.     begin
  516.     end;
  517.   until ( Finished and ( not LeftoversOnTable ));
  518.   { Return buffer as response string }
  519.   ResponseString := TheBuffer;
  520. end;
  521.  
  522. { Boilerplate error routine }
  523. procedure TFTPComponent.FTPSocketsErrorOccurred( Sender     : TObject;
  524.                                                  ErrorCode  : Integer;
  525.                                                  TheMessage : string   );
  526. begin
  527.   CCInetCCForm.SocketsErrorOccurred( Sender,ErrorCode,TheMessage );
  528. end;
  529.  
  530. { This is the FTP components initial connection routine }
  531. function TFTPComponent.EstablishConnection(
  532.           PCRPointer : PConnectionsRecord ) : Boolean;
  533. var TheReturnString : string;  { Internal string holder }
  534.     TheResult       : Integer; { Internal int holder    }
  535. begin
  536.   { Set default FTP Port value }
  537.   Socket1.PortName := '21';
  538.   { Get the ip address from the record }
  539.   Socket1.IPAddressName := PCRPointer^.CIPAddress;
  540.   { Set blocking mode }
  541.   Socket1.AsynchMode := False;
  542.   { Clear condition variables }
  543.   GlobalErrorCode := 0;
  544.   GlobalAbortedFlag := false;
  545.   { Actually attempt to connect }
  546.   Socket1.CCSockConnect;
  547.   { Check if connected }
  548.   if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 ) or
  549.       ( Socket1.TheSocket = INVALID_SOCKET )) then
  550.   begin { Didn't connect; signal error and abort }
  551.     { Do clever C formatting trick }
  552.     TheReturnString :=
  553.      DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  554.       [ PCRPointer^.CIPAddress ] );
  555.     { Put result in progress and status line }
  556.     AddProgressText( TheReturnString );
  557.     ShowProgressErrorText( TheReturnString );
  558.     { Signal error }
  559.     Result := False;
  560.     { leave }
  561.     exit;
  562.   end
  563.   else
  564.   begin
  565.     Connection_Established := true;
  566.     { Signal successful connection }
  567.     TheReturnString := DoCStyleFormat(
  568.       'Connected on Local port: %s with IP: %s',
  569.       [ Socket1.GetSocketPort( Socket1.TheSocket ),
  570.         Socket1.GetSocketIPAddress( Socket1.TheSocket )]);
  571.     { Put result in progress and status line }
  572.     CCINetCCForm.AddProgressText( TheReturnString );
  573.     CCINetCCForm.ShowProgressText( TheReturnString );
  574.     TheReturnString := DoCStyleFormat(
  575.      'Connected to Remote port: %s with IP: %s',
  576.       [ Socket1.GetSocketPeerPort( Socket1.TheSocket ),
  577.         Socket1.GetSocketPeerIPAddress( Socket1.TheSocket )]);
  578.     { Put result in progress and status line }
  579.     CCINetCCForm.AddProgressText( TheReturnString );
  580.     CCINetCCForm.ShowProgressText( TheReturnString );
  581.     TheReturnString := DoCStyleFormat( 'Successfully connected to %s',
  582.      [ Socket1.IPAddressName ]);
  583.     { Put result in progress and status line }
  584.     CCINetCCForm.AddProgressText( TheReturnString );
  585.     CCINetCCForm.ShowProgressText( TheReturnString );
  586.     repeat
  587.       TheResult := GetFTPServerResponse( TheReturnString );
  588.       { Put result in progress and status line }
  589.       AddProgressText( TheReturnString );
  590.       ShowProgressText( TheReturnString );
  591.     until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  592.     if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  593.     begin
  594.       { Do clever C formatting trick }
  595.       TheReturnString :=
  596.        DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  597.         [ PCRPointer^.CIPAddress ] );
  598.       { Put result in progress and status line }
  599.       AddProgressText( TheReturnString );
  600.       ShowProgressErrorText( TheReturnString );
  601.       { Signal error }
  602.       Result := False;
  603.       { leave }
  604.       exit;
  605.     end
  606.     else Result := true; { Signal no problem }
  607.   end;
  608. end;
  609.  
  610. { This is the FTP components USER login routine }
  611. function TFTPComponent.LoginUser(
  612.           PCRPointer : PConnectionsRecord ) : Boolean;
  613. var TheReturnString : string;  { Internal string holder }
  614.     TheResult       : Integer; { Internal int holder    }
  615. begin
  616.   TheReturnString :=
  617.    DoCStyleFormat( 'USER %s' ,
  618.     [ PCRPointer^.CUserName ] );
  619.   { Put result in progress and status line }
  620.   AddProgressText( TheReturnString );
  621.   ShowProgressText( TheReturnString );
  622.   { Begin login sequence with user name }
  623.   TheResult := PerformFTPCommand( 'USER %s',
  624.                                   [ PCRPointer^.CUserName ] );
  625.   if TheResult <> FTP_STATUS_PRELIMINARY then
  626.   begin
  627.     FTPCommandInProgress := false;
  628.     Result := false;
  629.     exit;
  630.   end;
  631.   repeat
  632.     TheResult := GetFTPServerResponse( TheReturnString );
  633.     { Put result in progress and status line }
  634.     AddProgressText( TheReturnString );
  635.     ShowProgressText( TheReturnString );
  636.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  637.   FTPCommandInProgress := false;
  638.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_CONTINUING )) then
  639.   begin
  640.     { Do clever C formatting trick }
  641.     TheReturnString :=
  642.      DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  643.       [ PCRPointer^.CIPAddress ] );
  644.     { Put result in progress and status line }
  645.     AddProgressText( TheReturnString );
  646.     ShowProgressErrorText( TheReturnString );
  647.     { Signal error }
  648.     Result := False;
  649.     { leave }
  650.     exit;
  651.   end
  652.   else Result := true; { Signal no problem }
  653. end;
  654.  
  655.  
  656. { This is the FTP components PASSWORD routine }
  657. function TFTPComponent.SendPassword(
  658.           PCRPointer : PConnectionsRecord ) : Boolean;
  659. var TheReturnString : string;  { Internal string holder }
  660.     TheResult       : Integer; { Internal int holder    }
  661. begin
  662.   TheReturnString := 'PASS XXXXXX' + #13#10;
  663.   { Put result in progress and status line }
  664.   AddProgressText( TheReturnString );
  665.   ShowProgressText( TheReturnString );
  666.   { Send Password sequence }
  667.   TheResult := PerformFTPCommand( 'PASS %s',
  668.                                   [ PCRPointer^.CPassword ] );
  669.   if TheResult <> FTP_STATUS_PRELIMINARY then
  670.   begin
  671.     Result := false;
  672.     FTPCommandInProgress := false;
  673.     exit;
  674.   end;
  675.   repeat
  676.     TheResult := GetFTPServerResponse( TheReturnString );
  677.     { Put result in progress and status line }
  678.     AddProgressText( TheReturnString );
  679.     ShowProgressText( TheReturnString );
  680.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  681.   FTPCommandInProgress := false;
  682.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  683.   begin
  684.     { Do clever C formatting trick }
  685.     TheReturnString :=
  686.      DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  687.       [ PCRPointer^.CIPAddress ] );
  688.     { Put result in progress and status line }
  689.     AddProgressText( TheReturnString );
  690.     ShowProgressErrorText( TheReturnString );
  691.     { Signal error }
  692.     Result := False;
  693.     { leave }
  694.     exit;
  695.   end
  696.   else Result := true; { Signal no problem }
  697. end;
  698.  
  699. { This is the FTP components CWD routine }
  700. function TFTPComponent.SetRemoteStartupDirectory(
  701.           PCRPointer : PConnectionsRecord ) : Boolean;
  702. var TheReturnString : string;  { Internal string holder }
  703.     TheResult       : Integer; { Internal int holder    }
  704. begin
  705.   Result := true;
  706.   if PCRPointer^.CStartDir <> '' then
  707.   begin
  708.     TheReturnString :=
  709.      DoCStyleFormat( 'CWD %s' ,
  710.       [ PCRPointer^.CStartDir ] );
  711.     { Put result in progress and status line }
  712.     AddProgressText( TheReturnString );
  713.     ShowProgressText( TheReturnString );
  714.     { Send Password sequence }
  715.     TheResult := PerformFTPCommand( 'CWD %s',
  716.                                     [ PCRPointer^.CStartDir ] );
  717.     if TheResult <> FTP_STATUS_PRELIMINARY then
  718.     begin
  719.       Result := false;
  720.       FTPCommandInProgress := false;
  721.       exit;
  722.     end;
  723.     repeat
  724.       TheResult := GetFTPServerResponse( TheReturnString );
  725.       { Put result in progress and status line }
  726.       AddProgressText( TheReturnString );
  727.       ShowProgressText( TheReturnString );
  728.    until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  729.    FTPCommandInProgress := false;
  730.    if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  731.     begin
  732.       { Do clever C formatting trick }
  733.       TheReturnString :=
  734.        DoCStyleFormat( 'CWD to %s Failed!' ,
  735.         [ PCRPointer^.CStartDir ] );
  736.       { Put result in progress and status line }
  737.       AddProgressText( TheReturnString );
  738.       ShowProgressErrorText( TheReturnString );
  739.       { Signal error }
  740.       Result := False;
  741.       { leave }
  742.       exit;
  743.     end
  744.     else Result := true; { Signal no problem }
  745.   end;
  746. end;
  747.  
  748. { This is the FTP components CWD routine }
  749. function TFTPComponent.SetRemoteDirectory( TheDir : string ) : Boolean;
  750. var TheReturnString : string;  { Internal string holder }
  751.     TheResult       : Integer; { Internal int holder    }
  752. begin
  753.   Result := true;
  754.   if TheDir <> '' then
  755.   begin
  756.     TheReturnString :=
  757.      DoCStyleFormat( 'CWD %s' ,
  758.       [ TheDir ] );
  759.     { Put result in progress and status line }
  760.     AddProgressText( TheReturnString );
  761.     ShowProgressText( TheReturnString );
  762.     { Send Password sequence }
  763.     TheResult := PerformFTPCommand( 'CWD %s',
  764.                                     [ TheDir ] );
  765.     if TheResult <> FTP_STATUS_PRELIMINARY then
  766.     begin
  767.       Result := false;
  768.       FTPCommandInProgress := false;
  769.       exit;
  770.     end;
  771.     repeat
  772.       TheResult := GetFTPServerResponse( TheReturnString );
  773.       { Put result in progress and status line }
  774.       AddProgressText( TheReturnString );
  775.       ShowProgressText( TheReturnString );
  776.    until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  777.    FTPCommandInProgress := false;
  778.    if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  779.     begin
  780.       { Do clever C formatting trick }
  781.       TheReturnString :=
  782.        DoCStyleFormat( 'CWD to %s Failed!' ,
  783.         [ TheDir ] );
  784.       { Put result in progress and status line }
  785.       AddProgressText( TheReturnString );
  786.       ShowProgressErrorText( TheReturnString );
  787.       { Signal error }
  788.       Result := False;
  789.       { leave }
  790.       exit;
  791.     end
  792.     else Result := true; { Signal no problem }
  793.   end;
  794. end;
  795.  
  796. { This is the FTP components QUIT routine }
  797. function TFTPComponent.Disconnect : Boolean;
  798. var TheReturnString : string;  { Internal string holder }
  799.     TheResult       : Integer; { Internal int holder    }
  800. begin
  801.   TheReturnString :=
  802.    DoCStyleFormat( 'QUIT' ,
  803.     [ nil ] );
  804.   { Put result in progress and status line }
  805.   AddProgressText( TheReturnString );
  806.   ShowProgressText( TheReturnString );
  807.   { Begin login sequence with user name }
  808.   TheResult := PerformFTPCommand( 'QUIT',
  809.                                   [ nil ] );
  810.   repeat
  811.     TheResult := GetFTPServerResponse( TheReturnString );
  812.     { Put result in progress and status line }
  813.     AddProgressText( TheReturnString );
  814.     ShowProgressText( TheReturnString );
  815.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  816.   FTPCommandInProgress := false;
  817.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  818.   begin
  819.     { Do clever C formatting trick }
  820.     TheReturnString :=
  821.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  822.       [ nil ] );
  823.     { Put result in progress and status line }
  824.     AddProgressText( TheReturnString );
  825.     ShowProgressErrorText( TheReturnString );
  826.     { Signal error }
  827.     Result := False;
  828.     { leave }
  829.     exit;
  830.   end
  831.   else Result := true; { Signal no problem }
  832. end;
  833.  
  834. { This is the FTP components PWD routine }
  835. function TFTPComponent.GetRemoteWorkingDirectory( var RemoteDir : string )
  836.           : Boolean;
  837. var TheReturnString : string;  { Internal string holder }
  838.     TheResult       : Integer; { Internal int holder    }
  839. begin
  840.   Result := true;
  841.   TheReturnString :=
  842.    DoCStyleFormat( 'PWD' ,
  843.     [ nil ] );
  844.   { Put result in progress and status line }
  845.   AddProgressText( TheReturnString );
  846.   ShowProgressText( TheReturnString );
  847.   { Send Password sequence }
  848.   TheResult := PerformFTPCommand( 'PWD',
  849.                                   [ nil ] );
  850.   if TheResult <> FTP_STATUS_PRELIMINARY then
  851.   begin
  852.     Result := false;
  853.     FTPCommandInProgress := false;
  854.     exit;
  855.   end;
  856.   repeat
  857.     TheResult := GetFTPServerResponse( TheReturnString );
  858.     { Put result in progress and status line }
  859.     AddProgressText( TheReturnString );
  860.     ShowProgressText( TheReturnString );
  861.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  862.   FTPCommandInProgress := false;
  863.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  864.   begin
  865.     { Do clever C formatting trick }
  866.     TheReturnString :=
  867.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  868.       [ nil ] );
  869.     { Put result in progress and status line }
  870.     AddProgressText( TheReturnString );
  871.     ShowProgressErrorText( TheReturnString );
  872.     { Signal error }
  873.     Result := False;
  874.     { leave }
  875.     exit;
  876.   end
  877.   else
  878.   begin
  879.     Result := true; { Signal no problem }
  880.     RemoteDir := TheReturnString; { Send back last string on faith }
  881.   end;
  882. end;
  883.  
  884. { This function sets up a listening port on socekt 2 and handle text replies }
  885. function TFTPComponent.GetListeningPort : Integer;
  886. var
  887.   Address1 ,
  888.   Address2 ,
  889.   Address3 ,
  890.   Address4        : Integer; { Address Integer conversions }
  891.   IPAddress       : string;  { IP Address holder           }
  892.   PortCommand     : string;  { Command holder              }
  893.   TheResult       : Integer; { Result holder               }
  894.   TheReturnString : string;  { ditto                       }
  895. begin
  896.   { Set up any port on socket 2 }
  897.   Socket2.PortName := '0';
  898.   { Listen on a socket }
  899.   Socket2.CCSockListen;
  900.   { Get the IP Address of socket 1 and convert it to numbers }
  901.   IPAddress := Socket1.GetSocketIPAddress( Socket1.TheSocket );
  902.   Address1 := StrToInt( copy( IPAddress , 1 , Pos( '.' , IPAddress ) -1 ));
  903.   IPAddress := copy( IPAddress , Pos( '.' , IPAddress ) + 1 , 255 );
  904.   Address2 := StrToInt( copy( IPAddress , 1 , Pos( '.' , IPAddress) -1 ));
  905.   IPAddress := copy( IPAddress , Pos( '.' , IPAddress ) + 1 , 255 );
  906.   Address3 := StrToInt( copy( IPAddress , 1 , Pos( '.' , IPAddress ) -1 ));
  907.   Address4 := StrToInt( copy( IPAddress , Pos( '.' , IPAddress ) + 1 , 255 ));
  908.   { Turn it into a command and add socket 2 stuff }
  909.   PortCommand := format( 'PORT %d,%d,%d,%d,%d,%d' ,
  910.    [ Address1 , Address2 , Address3 , Address4 ,
  911.     StrToInt( Socket2.GetSocketPort( Socket2.TheMasterSocket )) Shr 8,
  912.     StrToInt( Socket2.GetSocketPort( Socket2.TheMasterSocket )) and $ff ]);
  913.   { Put result in progress and status line }
  914.   AddProgressText( PortCommand + #13#10 );
  915.   ShowProgressText( PortCommand  + #13#10 );
  916.   TheResult := PerformFTPCommand( PortCommand , [nil] );
  917.   if TheResult <> FTP_STATUS_PRELIMINARY then
  918.   begin
  919.     Result := FTP_STATUS_FATAL_ERROR;
  920.     FTPCommandInProgress := false;
  921.     exit;
  922.   end;
  923.   repeat
  924.     TheResult := GetFTPServerResponse( TheReturnString );
  925.     { Put result in progress and status line }
  926.     AddProgressText( TheReturnString );
  927.     ShowProgressText( TheReturnString );
  928.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  929.   FTPCommandInProgress := false;
  930.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  931.   begin
  932.     { Do clever C formatting trick }
  933.     TheReturnString :=
  934.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  935.       [ nil ] );
  936.     { Put result in progress and status line }
  937.     AddProgressText( TheReturnString );
  938.     ShowProgressErrorText( TheReturnString );
  939.     { Signal error }
  940.     Result := TheResult;
  941.     { leave }
  942.     exit;
  943.   end
  944.   else
  945.   begin
  946.     { Return good result and leave }
  947.     Result := TheResult;
  948.     exit;
  949.   end;
  950. end;
  951.  
  952. { This function returns part of a unit text string }
  953. function TFTPComponent.GetUNIXTextString( var StringIn : string ) : string;
  954. var
  955.   ReturnString : string;
  956.   TheLength ,
  957.   Counter_1   : Integer;
  958. begin
  959.   TheLength := Length( StringIn );
  960.   if TheLength > 1 then
  961.   begin
  962.     for Counter_1 := 1 to TheLength do
  963.     begin
  964.       if StringIn[ Counter_1 ] = #10 then
  965.       begin
  966.         ReturnString := HolderLine;
  967.         HolderLine := '';
  968.         StringIn := Copy( StringIn , Counter_1 + 1 , 255 );
  969.         Result := ReturnString;
  970.         exit;
  971.       end
  972.       else
  973.       begin
  974.         if StringIn[ Counter_1 ] <> #0 then
  975.         begin
  976.           if StringIn[ Counter_1 ] <> #13 then
  977.            HolderLine := HolderLine + StringIn[ Counter_1 ];
  978.         end
  979.         else
  980.         begin
  981.           Result := '';
  982.           StringIn := '';
  983.         end;
  984.       end;
  985.     end;
  986.   end;
  987.   Result := '';
  988.   StringIn := '';
  989. end;
  990.  
  991. procedure TFTPComponent.GetFileNameFromUNIXFileName( var TheName : string );
  992. var Counter_1 : Integer;
  993.     ResultString : string;
  994.     Finished : Boolean;
  995. begin
  996.   if Pos( 'TOTAL' , Uppercase( TheName )) <> 0 then
  997.   begin
  998.     TheName := '';
  999.     exit;
  1000.   end;
  1001.   Counter_1 := Length( TheName );
  1002.   ResultString := '';
  1003.   Finished := false;
  1004.   while not Finished do
  1005.   begin
  1006.     if TheName[ Counter_1 ] <> ' ' then
  1007.     begin
  1008.       Counter_1 := Counter_1 - 1;
  1009.       if Counter_1 = 0 then
  1010.       begin
  1011.         ResultString := TheName;
  1012.         Finished := true;
  1013.       end;
  1014.     end
  1015.     else
  1016.     begin
  1017.       Finished := true;
  1018.       ResultString := Copy( TheName , Counter_1 + 1 , 255 );
  1019.     end;
  1020.   end;
  1021.   TheName := ResultString;
  1022. end;
  1023.  
  1024. { This is the FTP components get remote directory listing into a list box }
  1025. function TFTPComponent.GetRemoteDirectoryListing( TheListBox : TListBox )
  1026.           : Boolean;
  1027. var TheReturnString : string;  { Internal string holder }
  1028.     TheResult       : Integer; { Internal int holder    }
  1029.     InputString     : string;
  1030.     Through ,
  1031.     Finished        : Boolean;
  1032. begin
  1033.   TheListBox.Clear;
  1034.   TheListBox.Items.Add('..');
  1035.   Result := true;
  1036.   TheReturnString :=
  1037.    DoCStyleFormat( 'TYPE A' ,
  1038.     [ nil ] );
  1039.   { Put result in progress and status line }
  1040.   AddProgressText( TheReturnString );
  1041.   ShowProgressText( TheReturnString );
  1042.   { Send Password sequence }
  1043.   TheResult := PerformFTPCommand( 'TYPE A',
  1044.                                   [ nil ] );
  1045.   if TheResult <> FTP_STATUS_PRELIMINARY then
  1046.   begin
  1047.     Result := true;
  1048.     FTPCommandInProgress := false;
  1049.     exit;
  1050.   end;
  1051.   repeat
  1052.     TheResult := GetFTPServerResponse( TheReturnString );
  1053.     { Put result in progress and status line }
  1054.     AddProgressText( TheReturnString );
  1055.     ShowProgressText( TheReturnString );
  1056.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  1057.   FTPCommandInProgress := false;
  1058.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  1059.   begin
  1060.     { Do clever C formatting trick }
  1061.     TheReturnString :=
  1062.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  1063.       [ nil ] );
  1064.     { Put result in progress and status line }
  1065.     AddProgressText( TheReturnString );
  1066.     ShowProgressErrorText( TheReturnString );
  1067.     { Signal error }
  1068.     Result := true;
  1069.     { leave }
  1070.     exit;
  1071.   end
  1072.   else
  1073.   begin
  1074.     { Set up socket 2 for listening }
  1075.     Socket2.AsynchMode := False;
  1076.     Socket2.NonAsynchTimeoutValue := 60;
  1077.     { do a listen and send command to server that this is receipt socket }
  1078.     if GetListeningPort = FTP_STATUS_FATAL_ERROR then
  1079.     begin
  1080.       Socket2.CCSockCancelListen;
  1081.       exit;
  1082.     end;
  1083.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  1084.     TheResult := PerformFTPCommand( 'LIST' , [nil] );
  1085.     GetFTPServerResponse( TheReturnString );
  1086.     AddProgressText( TheReturnString );
  1087.     ShowProgressText( TheReturnString );
  1088.     Socket1.NonAsynchTimeoutValue := 30;
  1089.     if (( TheResult = FTP_STATUS_RETRY_COMMAND ) or
  1090.        ( TheResult = FTP_STATUS_FATAL_ERROR )) then
  1091.     begin
  1092.       TheReturnString :=
  1093.        DoCStyleFormat( 'Could not obtain remote directory!' ,
  1094.         [ nil ] );
  1095.       { Put result in progress and status line }
  1096.       AddProgressText( TheReturnString );
  1097.       ShowProgressErrorText( TheReturnString );
  1098.       Socket2.CCSockCancelListen;
  1099.       Result := true;
  1100.       exit;
  1101.     end;
  1102.     Socket2.CCSockAccept;
  1103.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  1104.     begin
  1105.       TheReturnString :=
  1106.        DoCStyleFormat( 'Could not establish receive socket!' ,
  1107.         [ nil ] );
  1108.       { Put result in progress and status line }
  1109.       AddProgressText( TheReturnString );
  1110.       ShowProgressErrorText( TheReturnString );
  1111.       Result := true;
  1112.       exit;
  1113.     end;
  1114.     Through := false;
  1115.     repeat
  1116.       TheReturnString := Socket2.StringData;
  1117.       if Length( TheReturnString ) = 0 then Through := true;
  1118.       if Length( TheReturnString ) > 0 then
  1119.       begin
  1120.         finished := false;
  1121.         while not finished do
  1122.         begin
  1123.           InputString := GetUNIXTextString( TheReturnString );
  1124.           if InputString = '' then Finished := true else
  1125.           begin
  1126.             GetFileNameFromUNIXFileName( InputString);
  1127.             If InputString <> '' then
  1128.             TheListBox.Items.Add( InputString );
  1129.           end;
  1130.         end;
  1131.       end;
  1132.       if GlobalAbortedFlag then
  1133.       begin
  1134.         Socket1.OutOfBand := 'ABOR'+#13#10;
  1135.         repeat
  1136.           TheResult := GetFTPServerResponse( TheReturnString );
  1137.           { Put result in progress and status line }
  1138.           AddProgressText( TheReturnString );
  1139.           ShowProgressText( TheReturnString );
  1140.         until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  1141.         result := true;
  1142.         exit;
  1143.       end;
  1144.     until Through;
  1145.     GetFTPServerResponse( TheReturnString );
  1146.     AddProgressText( TheReturnString );
  1147.     ShowProgressText( TheReturnString );
  1148.     { cancel listening on second socket and close it }
  1149.     Socket2.CCSockCancelListen;
  1150.     Socket2.CCSockClose;
  1151.   end;
  1152.   FTPCommandInProgress := false;
  1153. end;
  1154.  
  1155. { This is the FTP components get local directory listing into a list box }
  1156. function TFTPComponent.GetLocalDirectoryAndListing( var TheString : string;
  1157.                                                         TheListBox : TListBox )
  1158.           : Boolean;
  1159. var TheFLB : TFileListBox;
  1160. begin
  1161.   { Get the working directory }
  1162.   GetDir( 0 , TheString );
  1163.   { Clear incoming LB }
  1164.   TheListBox.Clear;
  1165.   TheFLB := TFileListBox.Create( Application.MainForm );
  1166.   TheFLB.Visible := false;
  1167.   TheFLB.Parent := Application.MainForm;
  1168.   TheFLB.FileType := [ ftNormal , ftDirectory ];
  1169.   TheFLB.Directory := TheString;
  1170.   TheFLB.Update;
  1171.   TheListBox.Items.Assign( TheFLB.Items );
  1172.   TheFLB.Free;
  1173.   result := true;
  1174. end;
  1175.  
  1176. { This is a clever c-style formatting trick }
  1177. function TFTPComponent.DoCStyleFormat(
  1178.                 TheText      : string;
  1179.           const TheArguments : array of const ) : string;
  1180. begin
  1181.   Result := Format( TheText , TheArguments ) + #13#10;
  1182. end;
  1183.  
  1184. function TFTPComponent.GetQuotedString( TheString : string ) : string;
  1185. var TheIndex     : Integer; { Holder var }
  1186.     ResultString : string;  { ditto      }
  1187. begin
  1188.   { Find out if " present at all }
  1189.   TheIndex := Pos( '"' , TheString );
  1190.   If TheIndex = 0 then
  1191.   begin
  1192.     { If not, return null string and exit }
  1193.     Result := '';
  1194.     exit;
  1195.   end
  1196.   else
  1197.   begin
  1198.     { Get from first " to end of string in holder }
  1199.     ResultString := Copy( TheString , TheIndex + 1 , 255 );
  1200.     { Find position to second " }
  1201.     TheIndex := Pos( '"' , ResultString );
  1202.     { If no ending " then return whole string and leave }
  1203.     if TheIndex = 0 then
  1204.     begin
  1205.       Result := ResultString;
  1206.       exit;
  1207.     end
  1208.     else
  1209.     begin
  1210.       { Get internal text between quotes and exit }
  1211.       ResultString := Copy( ResultString , 1 , TheIndex - 1 );
  1212.       Result := ResultString;
  1213.     end;
  1214.   end;
  1215. end;
  1216.  
  1217. procedure TCCINetCCForm.UpdateGauge( BytesFinished , TotalToHandle : longint );
  1218. var
  1219.   Percentage : longint;
  1220. begin
  1221.   if BytesFinished > TotalToHandle then BytesFinished := TotalToHandle;
  1222.   if TotalToHandle = 0 then exit;
  1223.   Percentage := Trunc( 100.0 / ( TotalToHandle / BytesFinished ));
  1224.   Gauge1.Progress := Percentage;
  1225.   Panel1.Caption := '  Status: Transfered ' + IntToStr( BytesFinished ) +
  1226.    ' bytes of file ' + FileNameToXFer + ' (' + IntToStr( Percentage ) + '% Complete)';
  1227. end;
  1228.  
  1229. { This procedure actually attempts to connect to the internet at an ftp site }
  1230. function TCCINetCCForm.DoFTPConnection( PCRPointer : PConnectionsRecord ) : boolean;
  1231. var TheReturnString : string; { Display results of connection in status lines }
  1232.     TheResult       : Integer;{ Result from FTP server                        }
  1233.     FTPLoggedIn     : Boolean;{ Boolean to signal successful login            }
  1234. begin
  1235.   { Create the component }
  1236.   Result := false;
  1237.   { Do busy cursors }
  1238.   SetHGCursors;
  1239.   if not TheFTPComponent.EstablishConnection( PCRPointer ) then
  1240.   begin
  1241.     { Do saved cursors }
  1242.     TheFTPComponent.FTPCommandInProgress := false;
  1243.     TheFTPComponent.Connection_Established := false;
  1244.     SetNormalCursors;
  1245.     exit;
  1246.   end
  1247.   else
  1248.   begin { Connected; continue login process }
  1249.     if not TheFTPComponent.LoginUser( PCRPointer ) then
  1250.     begin
  1251.       { Do saved cursors }
  1252.       TheFTPComponent.FTPCommandInProgress := false;
  1253.       TheFTPComponent.Connection_Established := false;
  1254.       SetNormalCursors;
  1255.       exit;
  1256.     end;
  1257.     if not TheFTPComponent.SendPassword( PCRPointer ) then
  1258.     begin
  1259.       { Do saved cursors }
  1260.       TheFTPComponent.FTPCommandInProgress := false;
  1261.       TheFTPComponent.Connection_Established := false;
  1262.       SetNormalCursors;
  1263.       exit;
  1264.     end;
  1265.     if not TheFTPComponent.SetRemoteStartupDirectory( PCRPointer ) then
  1266.     begin
  1267.       { Do saved cursors }
  1268.       SetNormalCursors;
  1269.       TheFTPComponent.Connection_Established := false;
  1270.       TheFTPComponent.FTPCommandInProgress := false;
  1271.       exit;
  1272.     end;
  1273.     if not TheFTPComponent.GetRemoteWorkingDirectory( TheReturnString ) then
  1274.     begin
  1275.       { Do saved cursors }
  1276.       TheFTPComponent.Connection_Established := false;
  1277.       TheFTPComponent.FTPCommandInProgress := false;
  1278.       SetNormalCursors;
  1279.       exit;
  1280.     end;
  1281.     { Put up remote directory via PWD and strip quotes }
  1282.     Label4.Caption := TheFTPComponent.GetQuotedString( TheReturnString );
  1283.     { Get the listings of directories and exit OK }
  1284.     TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  1285.     TheFTPComponent.GetLocalDirectoryAndListing( TheReturnString ,
  1286.      Listbox2 );
  1287.     if Label5.Canvas.TextWidth( TheReturnString ) > Label5.Width then
  1288.      TheReturnString := TheFTPComponent.GetShortPathName( TheReturnString );
  1289.     Label5.Caption := TheReturnString;
  1290.     SetNormalCursors;
  1291.     Result := true;
  1292.     EnableFTPMenus;
  1293.     TheFTPComponent.FTPCommandInProgress := false;
  1294.     Panel1.Caption := '  Status : Connected to ' + PCRPointer^.CIPAddress;
  1295.   end;
  1296. end;
  1297.  
  1298. { This procedure actually attempts to disconnect to the internet at an ftp site}
  1299. procedure TCCINetCCForm.DoFTPDisconnect;
  1300. begin
  1301.   { Call QUIT command }
  1302.   TheFTPComponent.Disconnect;
  1303.   { Kill the socket }
  1304.   TheFTPComponent.Socket1.CCSockClose;
  1305. end;
  1306.  
  1307. { This procedure reads in the ini file and default path info }
  1308. procedure TCCINetCCForm.ReadIniData;
  1309. begin
  1310.   TheICCIniFile := TIniFile.Create( 'CCICC.INI' );
  1311.   MailPath := TheICCIniFile.ReadString( 'Paths','MailPath','C:\WINDOWS' );
  1312.   NewsPath := TheICCIniFile.ReadString( 'Paths','NewsPath','C:\WINDOWS' );
  1313.   WWWPath := TheICCIniFile.ReadString( 'Paths','WWWPath','C:\WINDOWS' );
  1314.   FTPPath := TheICCIniFile.ReadString( 'Paths','FTPPath','C:\WINDOWS' );
  1315.   PasswordControlVector := TheICCIniFile.ReadInteger( 'Vectors','PWControl',2 );
  1316.   DefaultDownloadVector := TheICCIniFile.ReadInteger( 'Vectors','DefDL', 3 );
  1317.   TheAnonRedialVector := TheICCIniFile.ReadInteger( 'Vectors','AnonRD', 20 );
  1318.   TheICCIniFile.Free;
  1319. end;
  1320.  
  1321. { This procedure writes out default path data to the ini file }
  1322. procedure TCCINetCCForm.WriteIniData;
  1323. begin
  1324.   TheICCIniFile := TIniFile.Create( 'CCICC.INI' );
  1325.   TheICCIniFile.WriteString( 'Paths','MailPath',MailPath );
  1326.   TheICCIniFile.WriteString( 'Paths','NewsPath',NewsPath );
  1327.   TheICCIniFile.WriteString( 'Paths','WWWPath',WWWPath );
  1328.   TheICCIniFile.WriteString( 'Paths','FTPPath',FTPPath );
  1329.   TheICCIniFile.WriteInteger( 'Vectors','PWControl',PasswordControlVector );
  1330.   TheICCIniFile.WriteInteger( 'Vectors','DefDL',DefaultDownloadVector );
  1331.   TheICCIniFile.WriteInteger( 'Vectors','AnonRD', TheAnonRedialVector );
  1332.   TheICCIniFile.Free;
  1333. end;
  1334.  
  1335. { Procedure to load the FTP Site list }
  1336. procedure TCCINetCCForm.LoadFTPSiteFile;
  1337. var TheTCRecord : PConnectionsRecord; { Generic TCR Pointer    }
  1338.     FTPSLName   : string;             { FTP Site List filename }
  1339.     Counter_1   : Integer;            { Loop counter           }
  1340. begin
  1341.   { Create the sites list list }
  1342.   TheFTPSiteList := TList.Create;
  1343.   { Set up the FTP sites list file name }
  1344.   FTPSLName := FTPPath + '\FTPSITES.TCR';
  1345.   { If the FTP Site List exists load it in }
  1346.   if FileExists( FTPSLName ) then
  1347.   begin
  1348.     { set up the file and open it }
  1349.     AssignFile( TheFTPSiteFile , FTPSLName );
  1350.     Reset( TheFTPSiteFile );
  1351.     { read in the records }
  1352.     for Counter_1 := 0 to FileSize( TheFTPSiteFile ) - 1 do
  1353.     begin
  1354.       { Create the TCRecord }
  1355.       New( TheTCRecord );
  1356.       { Read in the data record }
  1357.       Seek( TheFTPSiteFile , Counter_1 );
  1358.       Read( TheFTPSiteFile , TheTCRecord^ );
  1359.       { Add the record to the list }
  1360.       TheFTPSiteList.Add( TheTCRecord );
  1361.     end;
  1362.     { close the file }
  1363.     CloseFile( TheFTPSiteFile );
  1364.   end
  1365.   else
  1366.   { Otherwise create a default one with a few anonymous sites }
  1367.   begin
  1368.     { create new record }
  1369.     New( TheTCRecord );
  1370.     { fill in its info }
  1371.     with TheTCRecord^ do
  1372.     begin
  1373.       CProfile   := 'Winsite Windows Archive';
  1374.       CIPAddress := 'ftp.winsite.com';
  1375.       CUserName  := 'anonymous';
  1376.       CPassword  := 'guest@nowhere.com';
  1377.       CStartDir  := '';
  1378.     end;
  1379.     { add it to the list }
  1380.     { do it three more times }
  1381.     TheFTPSiteList.Add( TheTCRecord );
  1382.     New( TheTCRecord );
  1383.     with TheTCRecord^ do
  1384.     begin
  1385.       CProfile   := 'Digital Equipment Corp';
  1386.       CIPAddress := 'gatekeeper.dec.com';
  1387.       CUserName  := 'anonymous';
  1388.       CPassword  := 'guest@nowhere.com';
  1389.       CStartDir  := '';
  1390.     end;
  1391.     TheFTPSiteList.Add( TheTCRecord );
  1392.     New( TheTCRecord );
  1393.     with TheTCRecord^ do
  1394.     begin
  1395.       CProfile   := 'Microsoft FTP Site';
  1396.       CIPAddress := 'ftp.microsoft.com';
  1397.       CUserName  := 'anonymous';
  1398.       CPassword  := 'guest@nowhere.com';
  1399.       CStartDir  := '';
  1400.     end;
  1401.     TheFTPSiteList.Add( TheTCRecord );
  1402.     New( TheTCRecord );
  1403.     with TheTCRecord^ do
  1404.     begin
  1405.       CProfile   := 'Oakland MSDOS Archive';
  1406.       CIPAddress := 'oak.oakland.edu';
  1407.       CUserName  := 'anonymous';
  1408.       CPassword  := 'guest@nowhere.com';
  1409.       CStartDir  := '';
  1410.     end;
  1411.     TheFTPSiteList.Add( TheTCRecord );
  1412.     { create the file and write out the data, then close it }
  1413.     AssignFile( TheFTPSiteFile , FTPSLName );
  1414.     Rewrite( TheFTPSiteFile );
  1415.     for Counter_1 := 0 to 3 do
  1416.     begin
  1417.       TheTCRecord :=
  1418.        PConnectionsRecord( TheFTPSiteList.Items[ Counter_1 ] );
  1419.       Seek( TheFTPSiteFile , Counter_1 );
  1420.       Write( TheFTPSiteFile , TheTCRecord^ );
  1421.     end;
  1422.     CloseFile( TheFTPSiteFile );
  1423.   end;
  1424. end;
  1425.  
  1426. { This procedure saves off the FTP Site List }
  1427. procedure TCCINetCCForm.SaveFTPSiteFile;
  1428. var TheTCRecord : PConnectionsRecord; { The TC Record pointer  }
  1429.     FTPSLName   : string;             { FTP Site List filename }
  1430.     Counter_1   : Integer;            { Loop counter           }
  1431. begin
  1432.   { Set up the file name }
  1433.   FTPSLName := FTPPath + '\FTPSITES.TCR';
  1434.   { Assign the file }
  1435.   AssignFile( TheFTPSiteFile , FTPSLName );
  1436.   { Rewrite it }
  1437.   Rewrite( TheFTPSiteFile );
  1438.   { run the list through the procedure }
  1439.   for Counter_1 := 0 to TheFTPSiteList.Count - 1 do
  1440.   begin
  1441.     { get the record from the list }
  1442.     TheTCRecord :=
  1443.      PConnectionsRecord( TheFTPSiteList.Items[ Counter_1 ] );
  1444.     { Do the seek/write }
  1445.     Seek( TheFTPSiteFile , Counter_1 );
  1446.     Write( TheFTPSiteFile , TheTCRecord^ );
  1447.     { free the record }
  1448.     Dispose( TheTCRecord );
  1449.   end;
  1450.   { Close the file }
  1451.   CloseFile( TheFTPSiteFile );
  1452.   { Free the list pointers }
  1453.   TheFTPSiteList.Free;
  1454.   TheWorkingFTPSL.Free;
  1455. end;
  1456.  
  1457. { This procedure switches in the FTP sites list to the info dlg and main cbox }
  1458. procedure TCCINetCCForm.SetupFTPSiteLists;
  1459. var ThePointer : PConnectionsRecord; { Generic PCR Pointer }
  1460.     Counter_1  : Integer;            { Loop counter        } 
  1461. begin
  1462.   { Set up display for main form }
  1463.   CCINetCCForm.Tag := 2;
  1464.   CCINetCCForm.Caption := 'CC Internet Command Center -- FTP Mode';
  1465.   CCINetCCForm.ViewWinsockInfo1.Enabled := false;
  1466.   CCINetCCForm.FTP1.Enabled := false;
  1467.   CCINetCCForm.FTP2.Enabled := true;
  1468.   CCINetCCForm.Label1.Caption := 'FTP Site:';
  1469.   CCINetCCForm.Button1.Caption := 'Connect';
  1470.   CCINetCCForm.Label4.Caption := 'Local Dir';
  1471.   CCINetCCForm.Label5.Caption := 'Remote Dir';
  1472.   { Set tag for FTP stuff }
  1473.   CCICInfoDlg.Tag := 2;
  1474.   { set up caption of main label }
  1475.   CCICInfoDlg.Label2.Caption := 'FTP Sites';
  1476.   { hide outline panel }
  1477.   CCICInfoDlg.Panel6.Visible := false;
  1478.   { clear the list box }
  1479.   CCICInfoDlg.ListBox2.Clear;
  1480.   CCINetCCForm.ComboBox1.Clear;
  1481.   { add profile strings to the list box }
  1482.   for Counter_1 := 0 to TheFTPSiteList.Count - 1 do
  1483.   begin
  1484.     CCICInfoDlg.ListBox2.Items.Add( PConnectionsRecord(
  1485.      TheFTPSiteList.Items[ Counter_1 ] )^.CProfile );
  1486.     CCINetCCForm.ComboBox1.Items.Add( PConnectionsRecord(
  1487.      TheFTPSiteList.Items[ Counter_1 ] )^.CProfile );
  1488.   end;
  1489.   { Set up caption of special button }
  1490.   CCICInfoDlg.Button1.Caption := 'Anonymous Login';
  1491.   { Start with top record }
  1492.   CCICInfoDlg.ListBox2.ItemIndex := 0;
  1493.   CCINetCCForm.ComboBox1.ItemIndex := 0;
  1494.   { put in data from top record and reset captions }
  1495.   with PConnectionsRecord( TheFTPSiteList.Items[ 0 ] )^ do
  1496.   begin
  1497.     with CCICInfoDlg do
  1498.     begin
  1499.       Edit1.Text := CProfile;
  1500.       Panel2.Caption := '            Name:';
  1501.       Edit2.Text := CIPAddress;
  1502.       Panel3.Caption := '     IP Address:';
  1503.       Edit3.Text := CUserName;
  1504.       Panel5.Caption := '    User Name:';
  1505.       case PasswordControlVector of
  1506.         1 : Edit4.Text := CPassword;
  1507.         2 : Edit4.Text := '**********';
  1508.       end;
  1509.       Panel8.Caption := '      Password:';
  1510.       Edit5.Text := CStartDir;
  1511.       Panel9.Caption := '    Starting Dir:';
  1512.     end;
  1513.   end;
  1514.   { Create the working copy for use to make safe changes in info dlg }
  1515.   TheWorkingFTPSL := TList.Create;
  1516.   For Counter_1 := 0 to TheFTPSiteList.Count - 1 do
  1517.   begin
  1518.     New( ThePointer );
  1519.     ThePointer^ := PConnectionsRecord( TheFTPSiteList.Items[ Counter_1 ] )^;
  1520.     TheWorkingFTPSL.Add( ThePointer );
  1521.   end;
  1522. end;
  1523.  
  1524. { This procedure scans a line of UNIX-style text for #10's and }
  1525. { outputs them as lines to the memo. It stops at #0.           }
  1526. procedure TCCINetCCForm.AddNullTermTextToMemo( TheTextToAdd   : string;
  1527.                                  TheMemoToAddTo : TMemo   );
  1528. var
  1529.   TextLength ,            { Total chars to output         }
  1530.   Counter_1    : Integer; { Loop Index                    }
  1531. begin
  1532.   { Make the target memo visible just in case }
  1533.   TheMemoToAddTo.Visible := true;
  1534.   { Find total chars to output }
  1535.   TextLength := Length( TheTextToAdd );
  1536.   { If none then leave }
  1537.   if TextLength = 0 then exit;
  1538.   { Loop along the string }
  1539.   for Counter_1 := 1 to TextLength do
  1540.   begin
  1541.     { If hit ASCII 10 then assume end of line and output }
  1542.     if TheTextToAdd[ Counter_1 ] = #10 then
  1543.     begin
  1544.       { Use a try loop incase memo fills up }
  1545.       try
  1546.         { Add the line }
  1547.         TheMemoToAddTo.Lines.Add( TheLine );
  1548.       except
  1549.         { If memo fills up }
  1550.         on EOutOfResources do
  1551.         begin
  1552.           { Clear the old data }
  1553.           TheMemoToAddTo.Clear;
  1554.           { Output the new }
  1555.           TheMemoToAddTo.Lines.Add( TheLine );
  1556.         end;
  1557.       end;
  1558.       { clear the output buffer }
  1559.       TheLine := '';
  1560.     end
  1561.     else
  1562.     { Otherwise look for null terminator from Winsock }
  1563.     begin
  1564.       { If don't hit null terminator then add the char to op buffer }
  1565.       if TheTextToAdd[ Counter_1 ] <> #0 then
  1566.       begin
  1567.         TheLine := TheLine + TheTextToAdd[ Counter_1 ];
  1568.       end
  1569.       else
  1570.       begin
  1571.         if TheLine <> '' then
  1572.         begin
  1573.           { Use a try loop incase memo fills up }
  1574.           try
  1575.             { Add the line }
  1576.             TheMemoToAddTo.Lines.Add( TheLine );
  1577.           except
  1578.             { If memo fills up }
  1579.             on EOutOfResources do
  1580.             begin
  1581.               { Clear the old data }
  1582.               TheMemoToAddTo.Clear;
  1583.               { Output the new }
  1584.               TheMemoToAddTo.Lines.Add( TheLine );
  1585.             end;
  1586.           end;
  1587.           { clear the output buffer }
  1588.           TheLine := '';
  1589.         end;
  1590.       end;
  1591.     end;
  1592.   end;
  1593. end;
  1594.  
  1595. { This function scans a line of UNIX-style text for #10's and }
  1596. { outputs the first line as its return value,stopping at #0.  }
  1597. function TCCINetCCForm.AddNullTermTextToLabel( TheTextToAdd   : string ) : string;
  1598. var
  1599.   TheLine      : string;  { Buffer to output current line }
  1600.   TextLength ,            { Total chars to output         }
  1601.   Counter_1    : Integer; { Loop Index                    }
  1602. begin
  1603.   { Clear output buffer }
  1604.   TheLine := '';
  1605.   { Find total chars to output }
  1606.   TextLength := Length( TheTextToAdd );
  1607.   { If none then leave }
  1608.   if TextLength = 0 then
  1609.   begin
  1610.     { Return nothing }
  1611.     Result := '';
  1612.     { Leave }
  1613.     exit;
  1614.   end;
  1615.   { Loop along the string }
  1616.   for Counter_1 := 1 to TextLength do
  1617.   begin
  1618.     { If hit ASCII 10 then assume end of line and output }
  1619.     if TheTextToAdd[ Counter_1 ] = #10 then
  1620.     begin
  1621.       { Return first line }
  1622.       Result := TheLine;
  1623.       { Leave }
  1624.       exit;
  1625.     end
  1626.     else
  1627.     { Otherwise look for null terminator from Winsock }
  1628.     begin
  1629.       { If don't hit null terminator then add the char to op buffer }
  1630.       if TheTextToAdd[ Counter_1 ] <> #0 then
  1631.       begin
  1632.         TheLine := TheLine + TheTextToAdd[ Counter_1 ];
  1633.       end
  1634.       else break; { Otherwise drop out of the loop }
  1635.     end;
  1636.   end;
  1637.   { If hit #0 before #10 return buffer }
  1638.   Result := TheLine;
  1639. end;
  1640.  
  1641. { Show busy cursors }
  1642. procedure TCCINetCCForm.SetHGCursors;
  1643. begin
  1644.   CCInetCCForm.Cursor := crHourGlass;
  1645.   CCInetCCForm.Memo1.Cursor := crHourGlass;
  1646. end;
  1647.  
  1648. { Show normal cursors }
  1649. procedure TCCINetCCForm.SetNormalCursors;
  1650. begin
  1651.   CCInetCCForm.Cursor := crDefault;
  1652.   CCInetCCForm.Memo1.Cursor := crDefault;
  1653. end;
  1654.  
  1655. { Exit method }
  1656. procedure TCCINetCCForm.Exit1Click(Sender: TObject);
  1657. begin
  1658.   Close;
  1659. end;
  1660.  
  1661. { This method adds a line to the progress text stringlist  }
  1662. { If an exception occurs, the list is full, and it is auto }
  1663. { saved to the progress text file name, then cleared.      }
  1664. procedure TCCINetCCForm.AddProgressText( WhatText : string );
  1665. begin
  1666.   { Use a try..except loop to catch list overflows }
  1667.   try
  1668.     { Try the normal add }
  1669.     ProgressList.Add( WhatText );
  1670.   except
  1671.     { Any list error is assumed to be a list overflow }
  1672.     on EListError do
  1673.     begin
  1674.       { Save the list to the preset file name }
  1675.       ProgressList.SaveToFile( ProgressFileName );
  1676.       { Clear the list to make more room }
  1677.       ProgressList.Clear;
  1678.       { And redo the add; any further errors will except normally }
  1679.       ProgressList.Add( WhatText );
  1680.     end;
  1681.     { This might happen too! }
  1682.     on EOutOfResources do
  1683.     begin
  1684.       { Save the list to the preset file name }
  1685.       ProgressList.SaveToFile( ProgressFileName );
  1686.       { Clear the list to make more room }
  1687.       ProgressList.Clear;
  1688.       { And redo the add; any further errors will except normally }
  1689.       ProgressList.Add( WhatText );
  1690.     end;
  1691.   end;
  1692. end;
  1693.  
  1694. { This method either adds the progress line to the current memo }
  1695. { or puts it in the status caption at normal colors.            }
  1696. procedure TCCINetCCForm.ShowProgressText( WhatText : string );
  1697. begin
  1698.   { Use the POV to determine where to show progress info }
  1699.   case ProgressOutputVector of
  1700.     POV_MEMO : begin { Output into the memo  }
  1701.                  AddNullTermTextToMemo( WhatText , Memo1 );
  1702.                end;
  1703.     POV_STAT : begin { Output on status line }
  1704.                  { Set panel caption font to black }
  1705.                  Panel1.Font.Color := clBlack;
  1706.                  { Get the first line of text and put in caption }
  1707.                  Panel1.Caption := AddNullTermTextToLabel( WhatText );
  1708.                end;
  1709.   end;
  1710. end;
  1711.  
  1712. { This method is identical with SPT except sets status color to red and beeps }
  1713. procedure TCCINetCCForm.ShowProgressErrorText( WhatText : string );
  1714. begin
  1715.   { Do error beep }
  1716.   MessageBeep( mb_IconExclamation );
  1717.   { Use the POV to determine where to show progress info }
  1718.   case ProgressOutputVector of
  1719.     POV_MEMO : begin { Output into the memo  }
  1720.                  AddNullTermTextToMemo( WhatText , Memo1 );
  1721.                end;
  1722.     POV_STAT : begin { Output on status line }
  1723.                  { Set panel caption font to black }
  1724.                  Panel1.Font.Color := clRed;
  1725.                  { Get the first line of text and put in caption }
  1726.                  Panel1.Caption := AddNullTermTextToLabel( WhatText );
  1727.                end;
  1728.   end;
  1729. end;
  1730.  
  1731. { This is the boilerplate method used to handle Socket errors gracefully }
  1732. procedure TCCINetCCForm.SocketsErrorOccurred( Sender     : TObject;
  1733.                                               ErrorCode  : Integer;
  1734.                                               TheMessage : string   );
  1735. begin
  1736.   { Set the global error code flag }
  1737.   GlobalErrorCode := ErrorCode;
  1738.   { If a timeout error }
  1739.   if ErrorCode = WSAETIMEDOUT then
  1740.   begin
  1741.     { Set the aborted flag }
  1742.     GlobalAbortedFlag := True;
  1743.     { But clear the error code for graceful handling }
  1744.     GlobalErrorCode := 0;
  1745.   end
  1746.   else
  1747.   begin
  1748.     { Otherwise set the progress buffer to the error message }
  1749.     AddProgressText( TheMessage );
  1750.     { And show the progress text as set by option }
  1751.     ShowProgressErrorText( TheMessage );
  1752.   end;
  1753. end;
  1754.  
  1755. procedure TCCINetCCForm.FormCreate(Sender: TObject);
  1756. begin
  1757.   { Create the progress string list }
  1758.   ProgressList := TStringList.Create;
  1759.   { Create the file name for saving the progress list }
  1760.   ProgressFileName := ExpandFileName( 'PROGRESS.TXT' );
  1761.   { Default progress output to status line }
  1762.   ProgressOutputVector := POV_STAT;
  1763.   { Set password control stuff }
  1764.   PasswordControlVector := 2;
  1765.   CurrentPasswordString := 'guest@nowhere.com';
  1766.   CurrentRealPWString := 'guest@nowhere.com';
  1767.   { Get Ini file Data }
  1768.   ReadIniData;
  1769.   LoadFTPSiteFile;
  1770. end;
  1771.  
  1772. procedure TCCINetCCForm.FormDestroy(Sender: TObject);
  1773. begin
  1774.   { Free the progress text stringlist if assigned }
  1775.   if assigned( ProgressList ) then ProgressList.Free;
  1776.   { Save off the Ini data }
  1777.   WriteIniData;
  1778.   { Save and remove FTP site list stuff }
  1779.   SaveFTPSiteFile;
  1780.   if Assigned( TheFTPComponent ) then TheFTPComponent.Free;
  1781. end;
  1782.  
  1783. procedure TCCINetCCForm.Description1Click(Sender: TObject);
  1784. var
  1785.   TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  1786.   TheData    : string;    { Holder for data                           }
  1787. begin
  1788.   { Create socket; auto calls WSAStartup }
  1789.   TempSocket := TCCSocket.Create( Self );
  1790.   { Do parent just for kicks; no longer needed }
  1791.   TempSocket.Parent := self;
  1792.   { Put in error handler }
  1793.   TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  1794.   TheData := StrPas( TempSocket.Socket_WSA_Data.Description_String );
  1795.   { Display the Description string }
  1796.   AddProgressText( TheData + #0 );
  1797.   { And show the progress text as set by option }
  1798.   ShowProgressText( TheData + #0 );
  1799.   { Free the socket; auto calls WSACleanup }
  1800.   TempSocket.Free;
  1801. end;
  1802.  
  1803. procedure TCCINetCCForm.SystemStatus1Click(Sender: TObject);
  1804. var
  1805.   TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  1806.   TheData    : string;    { Holder for data                           }
  1807. begin
  1808.   { Create socket; auto calls WSAStartup }
  1809.   TempSocket := TCCSocket.Create( Self );
  1810.   { Do parent just for kicks; no longer needed }
  1811.   TempSocket.Parent := self;
  1812.   { Put in error handler }
  1813.   TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  1814.   TheData := StrPas( TempSocket.Socket_WSA_Data.System_Status_String );
  1815.   { Display the Description string }
  1816.   AddProgressText( TheData + #0 );
  1817.   { And show the progress text as set by option }
  1818.   ShowProgressText( TheData + #0 );
  1819.   { Free the socket; auto calls WSACleanup }
  1820.   TempSocket.Free;
  1821. end;
  1822.  
  1823. procedure TCCINetCCForm.VendorSpecific1Click(Sender: TObject);
  1824. var
  1825.   TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  1826.   TheData    : string;    { Holder for data                           }
  1827. begin
  1828.   { Create socket; auto calls WSAStartup }
  1829.   TempSocket := TCCSocket.Create( Self );
  1830.   { Do parent just for kicks; no longer needed }
  1831.   TempSocket.Parent := self;
  1832.   { Put in error handler }
  1833.   TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  1834.   TheData := StrPas( TempSocket.Socket_WSA_Data.Vendor_Specific_String );
  1835.   { Display the Description string }
  1836.   AddProgressText( TheData + #0 );
  1837.   { And show the progress text as set by option }
  1838.   ShowProgressText( TheData + #0 );
  1839.   { Free the socket; auto calls WSACleanup }
  1840.   TempSocket.Free;
  1841. end;
  1842.  
  1843. { This method sets the progress output vector to the memo }
  1844. procedure TCCINetCCForm.ViewInEditWindow1Click(Sender: TObject);
  1845. begin
  1846.   { Set the vector }
  1847.   ProgressOutputVector := POV_MEMO;
  1848.   { Keep the menu options consistent }
  1849.   ViewInEditWindow1.Checked := true;
  1850.   ViewInStatusLine1.Checked := false;
  1851. end;
  1852.  
  1853. { This method sets the progress output vector to the status line }
  1854. procedure TCCINetCCForm.ViewInStatusLine1Click(Sender: TObject);
  1855. begin
  1856.   { Set the vector }
  1857.   ProgressOutputVector := POV_STAT;
  1858.   { Keep the menus consistent }
  1859.   ViewInEditWindow1.Checked := false;
  1860.   ViewInStatusLine1.Checked := true;
  1861. end;
  1862.  
  1863. procedure TCCINetCCForm.SaveToFile1Click(Sender: TObject);
  1864. begin
  1865.   { Set up the dialog parameters }
  1866.   OpenDialog1.Filename := ProgressFileName;
  1867.   OpenDialog1.Title := 'Select Filename for Progress File';
  1868.   OpenDialog1.Filter := 'Text Files|*.txt';
  1869.   { If the dialog is not cancelled then save and clear }
  1870.   if OpenDialog1.Execute then
  1871.   begin
  1872.     ProgressFileName := OpenDialog1.FileName;
  1873.     ProgressList.SaveToFile( ProgressFileName );
  1874.     ProgressList.Clear;
  1875.   end;
  1876. end;
  1877.  
  1878. procedure TCCINetCCForm.IPAddress1Click(Sender: TObject);
  1879. begin
  1880.   { Set up info dialog for IP Address getting }
  1881.   CCICInfoDlg.Caption := 'CC Internet Center -- Translate IP Address';
  1882.   CCICInfoDlg.Panel4.Visible := false;
  1883.   CCICInfoDlg.Panel6.Visible := false;
  1884.   CCICInfoDlg.Panel9.Visible := false;
  1885.   CCICInfoDlg.Panel8.Visible := false;
  1886.   CCICInfoDlg.BitBtn2.Visible := false;
  1887.   CCICInfoDlg.Button1.Caption := 'Get IP Address';
  1888.   CCICInfoDlg.Button2.Visible := false;
  1889.   CCICInfoDlg.Button3.Visible := false;
  1890.   CCICInfoDlg.Button4.Visible := false;
  1891.   CCICInfoDlg.Panel2.Caption := 'IP Addr Name:';
  1892.   CCICInfoDlg.Panel3.Caption := '    Dotted Dec:';
  1893.   CCICInfoDlg.Panel5.Caption := '           Binary:';
  1894.   CCICInfoDlg.Edit1.Text := '';
  1895.   CCICInfoDlg.Edit2.Text := '';
  1896.   CCICInfoDlg.Edit3.Text := '';
  1897.   { Set IP Address Mode }
  1898.   CCICInfoDlg.Tag := 1;
  1899.   { Show Modally to get the information }
  1900.   CCICInfoDlg.ShowModal;
  1901.   { Reset the info dialog to default conditions }
  1902.   CCICInfoDlg.Caption := 'CC Internet Command Center Information Dialog';
  1903.   CCICInfoDlg.Panel4.Visible := true;
  1904.   CCICInfoDlg.Panel6.Visible := true;
  1905.   CCICInfoDlg.Panel9.Visible := true;
  1906.   CCICInfoDlg.Panel8.Visible := true;
  1907.   CCICInfoDlg.BitBtn2.Visible := true;
  1908.   CCICInfoDlg.Button1.Caption := 'Anonymous Login';
  1909.   CCICInfoDlg.Button2.Visible := true;
  1910.   CCICInfoDlg.Button3.Visible := true;
  1911.   CCICInfoDlg.Button4.Visible := true;
  1912.   CCICInfoDlg.Panel2.Caption := '             Name:';
  1913.   CCICInfoDlg.Panel3.Caption := '    IP Address:';
  1914.   CCICInfoDlg.Panel5.Caption := ' User Name:';
  1915.   CCICInfoDlg.Edit1.Text := '';
  1916.   CCICInfoDlg.Edit2.Text := '';
  1917.   CCICInfoDlg.Edit3.Text := '';
  1918. end;
  1919.  
  1920. procedure TCCINetCCForm.FTP1Click(Sender: TObject);
  1921. begin
  1922.   { Set up the FTP Data displays }
  1923.   SetupFTPSiteLists;
  1924.   TheFTPComponent := TFTPComponent.Create( CCInetCCForm );
  1925.   TheFTPComponent.Parent := CCInetCCForm;
  1926. end;
  1927.  
  1928. procedure TCCINetCCForm.FormResize(Sender: TObject);
  1929. begin
  1930.   { Use tag vector to determine what to do }
  1931.   case Tag of
  1932.     { if FTP , make sure two list boxes are same height }
  1933.     2 : Panel6.Height := (( Panel4.Height div 2 ) - 30 );
  1934.   end;
  1935. end;
  1936.  
  1937. procedure TCCINetCCForm.FTPSites1Click(Sender: TObject);
  1938. begin
  1939.   { Show Modally to get the information }
  1940.   CCICInfoDlg.ShowModal;
  1941. end;
  1942.  
  1943. procedure TCCINetCCForm.FTP3Click(Sender: TObject);
  1944. begin
  1945.   CCICPrefsDlg.TabbedNoteBook1.PageIndex := 1;
  1946.   CCICPrefsDlg.Tag := 2;
  1947.   CCICPrefsDlg.ShowModal;
  1948. end;
  1949.  
  1950. procedure TCCINetCCForm.ConnectToSite1Click(Sender: TObject);
  1951. var Counter_1 : Integer;
  1952. begin
  1953.   if Lowercase( PConnectionsRecord( TheFTPSiteList.Items[
  1954.    ComboBox1.ItemIndex ] )^.CUserName ) = 'anonymous' then
  1955.   begin
  1956.     for Counter_1 := 1 to TheAnonRedialVector do
  1957.     begin
  1958.       DoFTPConnection( PConnectionsRecord(
  1959.          TheFTPSiteList.Items[ ComboBox1.ItemIndex ] ));
  1960.       if TheFTPComponent.Connection_Established then exit;
  1961.     end;
  1962.   end
  1963.   else DoFTPConnection( PConnectionsRecord(
  1964.    TheFTPSiteList.Items[ ComboBox1.ItemIndex ] ));
  1965. end;
  1966.  
  1967. procedure TCCINetCCForm.Button1Click(Sender: TObject);
  1968. begin
  1969.   case Tag of
  1970.     2 : begin
  1971.           if not TheFTPComponent.Connection_Established then
  1972.            ConnectToSite1Click( Self ) else
  1973.            begin
  1974.              DoFTPDisconnect;
  1975.              TheFTPComponent.Connection_Established := false;
  1976.              DisableFTPMenus;
  1977.            end;
  1978.         end;
  1979.   end;
  1980. end;
  1981.  
  1982. procedure TCCINetCCForm.Disconnect1Click(Sender: TObject);
  1983. begin
  1984.   DoFTPDisconnect;
  1985.   DisableFTPMenus;
  1986. end;
  1987.  
  1988. procedure TCCINetCCForm.EnableFTPMenus;
  1989. begin
  1990.   Button1.Caption := 'Disconnect';
  1991.   ConnectToSite1.Enabled := false;
  1992.   Disconnect1.Enabled := true;
  1993.   Directory1.Enabled := true;
  1994.   UploadMarked1.Enabled := true;
  1995.   DownloadMarked1.Enabled := true;
  1996. end;
  1997.  
  1998. procedure TCCINetCCForm.DisableFTPMenus;
  1999. begin
  2000.   Button1.Caption := 'Connect';
  2001.   ConnectToSite1.Enabled := true;
  2002.   Disconnect1.Enabled := false;
  2003.   Directory1.Enabled := false;
  2004.   UploadMarked1.Enabled := false;
  2005.   DownloadMarked1.Enabled := false;
  2006. end;
  2007.  
  2008. procedure TCCINetCCForm.Change1Click(Sender: TObject);
  2009. var TheDir : string;
  2010. begin
  2011.   if ListBox1.ItemIndex = -1 then exit;
  2012.   TheDir := ListBox1.Items[ ListBox1.ItemIndex ];
  2013.   if TheFTPComponent.SetRemoteDirectory( TheDir ) then
  2014.   begin
  2015.     TheFTPComponent.GetRemoteWorkingDirectory( TheDir ); 
  2016.     { Put up remote directory via PWD and strip quotes }
  2017.     Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  2018.     { Get the listings of directories and exit OK }
  2019.     TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  2020.   end;
  2021. end;
  2022.  
  2023. procedure TCCINetCCForm.ChangeLocal1Click(Sender: TObject);
  2024. var TheDir : string;
  2025. begin
  2026.   if ListBox2.ItemIndex = -1 then exit;
  2027.   TheDir := ListBox2.Items[ ListBox2.ItemIndex ];
  2028.   TheDir := TheFTPComponent.StripBrackets( TheDir );
  2029.   if TheDir = '..' then
  2030.   begin
  2031.     ChDir( TheDir );
  2032.   end
  2033.   else
  2034.   begin
  2035.     TheDir := ExpandFileName( TheDir );
  2036.     ChDir( TheDir );
  2037.   end;
  2038.   TheFTPComponent.GetLocalDirectoryAndListing( TheDir , Listbox2 );
  2039.   if Label5.Canvas.TextWidth( TheDir ) > Label5.Width then
  2040.    TheDir := TheFTPComponent.GetShortPathName( TheDir );
  2041.   Label5.Caption := TheDir;
  2042. end;
  2043.  
  2044. procedure TCCINetCCForm.ListBox1DblClick(Sender: TObject);
  2045. begin
  2046.   case Tag of
  2047.     2 : begin
  2048.           case DefaultDownLoadVector of
  2049.             3 : Change1Click( Self );
  2050.           end;
  2051.         end;
  2052.   end;
  2053. end;
  2054.  
  2055. procedure TCCINetCCForm.ListBox2DblClick(Sender: TObject);
  2056. begin
  2057.   case Tag of
  2058.     2 : begin
  2059.           case DefaultDownLoadVector of
  2060.             3 : ChangeLocal1Click( Self );
  2061.           end;
  2062.         end;
  2063.   end;
  2064. end;
  2065.  
  2066. end.
  2067.